home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / ANSI.SWG / 0036_ANSI Save to file.pas < prev    next >
Pascal/Delphi Source File  |  1995-02-28  |  3KB  |  149 lines
  1. {
  2. I have code that will save a textmode screen to an ANSI format
  3.  text file by reading the text mode screen directly. The code came
  4.  from another discussion on saving text screens to ANSI files;
  5.  the code is not mine.
  6. }
  7.  
  8. PROGRAM Ansi_Save_Screen;
  9. {*
  10.  * Save a color-screen in Ansi-format. Simple way, char by char: blanks
  11.  * not skipped.
  12.  *}
  13. Uses
  14.  Dos;
  15.  
  16. PROCEDURE SaveANSI(Filename : PathStr);
  17. CONST
  18.  Esc = #27;
  19.  MaxCol  = 70;
  20.  AnsiCols : array [0..7] of char = '04261537';
  21.  
  22. TYPE
  23.  TCell = RECORD
  24. C : Char;
  25. A : byte;
  26.  END;
  27.  TScreen = array [1..25, 1..80] of TCell;
  28.  
  29.  ANSIATTR = record
  30. Bright : boolean;
  31. Blink : boolean;
  32. FG : byte;
  33. BG : byte;
  34.  end;
  35.  
  36. VAR
  37.  Screen  : TSCreen ABSOLUTE $B800:$0000;
  38.  F: text;
  39.  X, Y : byte;
  40.  s, s1: String;
  41.  AnsiLast,
  42.  AnsiTmp : ANSIATTR;
  43.  
  44. function WriteAttr(var Old, New : ANSIATTR) : string;
  45. { Write Attributes (ESC[..m) into a string }
  46. var
  47.  s : string;
  48. begin
  49.  WriteAttr := '';
  50.  s := ESC + '[';
  51.  if (not(New.Bright = Old.Bright)) or (not(New.Blink = Old.Blink)) then
  52.  begin
  53. if (Not (New.Bright and New.Blink)) then
  54.  s := s + '0;'
  55. else
  56. if (not New.Bright) and (New.Blink) then
  57. begin
  58.  if Old.Bright then
  59. s := s + '0;5;'
  60.  else
  61. s := s + '5;';
  62. end
  63. else
  64. if (New.Bright) and (not New.Blink) then
  65. begin
  66.  if Old.Blink then
  67. s := s + '0;1;'
  68.  else
  69. s := s + '1;';
  70. end
  71. else
  72. begin
  73.  if not Old.Bright then
  74. s := s + '1;';
  75.  if not Old.Blink then
  76. s := s + '5;';
  77. end;
  78.  end;
  79.  
  80.  if (Old.FG <> New.FG) or ((not New.Bright) and Old.Bright) or
  81.   ((not New.Blink) and Old.Blink) then
  82.  begin
  83. {* I don't have no info why, but obviously backswitching to dark
  84.  * colorset, what has to be done via ^[0m, must turn fg/bg colors to
  85.  * 37/40. However, we can optimize still then a bit !-. *}
  86. if not ( (New.FG=7) and ((not New.Bright) and Old.Bright) )
  87.   then s:=s+'3'+AnsiCols[New.FG]+';';
  88.  end;
  89.  
  90.  if (Old.BG<>New.BG) or ((not New.Bright) and Old.Bright) or
  91.  ((not New.Blink) and Old.Blink) then
  92.  begin
  93. if not ( (New.BG=0) and ((not New.Bright) and Old.Bright) )
  94.   then s:=s+'4'+AnsiCols[New.BG]+';';
  95.  end;
  96.  
  97.  if s[length(s)]=';' then s[length(s)]:='m' else s:=s+'m';
  98.  
  99.  if length(s)>length(ESC+'[m') then WriteAttr:=s;
  100. end;
  101.  
  102. BEGIN
  103.  Assign(F, filename);
  104.  Rewrite(F);
  105.  
  106.  AnsiTmp.FG := Screen[1, 1].A and 15;
  107.  AnsiTmp.BG := Screen[1, 1].A SHR 4;
  108.  AnsiTmp.Blink := (AnsiTmp.BG AND 8) = 8;
  109.  AnsiTmp.Bright := (AnsiTmp.FG AND 8) = 8;
  110.  AnsiTmp.FG:=AnsiTmp.FG and 7;
  111.  AnsiTmp.BG:=AnsiTmp.BG and 7;
  112.  
  113.  s:=Esc+'[2J'+Esc+'[0m'+ESC+'[';
  114.  if AnsiTmp.Bright then s:=s+'1;';
  115.  if AnsiTmp.Blink then s:=s+'5;';
  116.  s:=s+'3'+ansicols[AnsiTmp.FG]+';';
  117.  s:=s+'4'+ansicols[AnsiTmp.BG]+'m';
  118.  
  119.  FOR Y := 1 TO 25 DO
  120. BEGIN
  121.  FOR X := 1 TO 80 DO
  122.   BEGIN
  123.  AnsiLast:=AnsiTmp;
  124.  
  125.  AnsiTmp.FG := Screen[Y, X].A AND 15;
  126.  AnsiTmp.BG := Screen[Y, X].A SHR 4;
  127.  AnsiTmp.Bright := (AnsiTmp.FG AND 8)<>0;
  128.  AnsiTmp.Blink := (AnsiTmp.BG AND 8)<>0;
  129.  AnsiTmp.FG:=AnsiTmp.FG and 7;
  130.  AnsiTmp.BG:=AnsiTmp.BG and 7;
  131.  
  132.  s1:=WriteAttr(AnsiLast, AnsiTmp);
  133.  s1:=s1+Screen[Y, X].C;
  134.  
  135.  IF (length(s+s1+ESC+'[s')) <= MaxCol then s:=s+s1 else
  136.  begin
  137.   Write(F,s+ESC+'[s'+#13#10);
  138.   s:=ESC+'[u'+s1;
  139.  end;
  140.  
  141.   END;
  142. END;
  143. Write(F, Esc+'[0;37;40m');
  144. Close(F);
  145. END;
  146. BEGIN
  147.  SaveANSI('test3.ans');
  148. END.
  149.